{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit ItParser;

interface

uses
  Classes, SysUtils, MiscUtils, ItCommon, TestCore, Profile, SelectQuestion,
  InputQuestion, MatchQuestion, OrderQuestion, ClassifyQuestion, Pad, Script,
  CommonModifiers, TestUtils;

type
  TXmlElement = class;
  TXmlElementList = TGenericObjectList<TXmlElement>;

  TXmlElement = class
  private type
    TXmlAttribute = class
    private
      FName: String;
      FValue: String;
    public
      constructor Create(const Name, Value: String);
    end;
    TXmlAttributeList = TGenericObjectList<TXmlAttribute>;
  private
    FName: String;
    FAttrs: TXmlAttributeList;
    FElements: TXmlElementList;
    function GetAttrCount: Integer;
    function GetElementCount: Integer;
    function GetElements(Index: Integer): TXmlElement;
  public
    constructor Create(const Name: String);
    destructor Destroy; override;
    procedure AddAttr(const Name, Value: String);
    function GetAttr(const Name: String; out Value: String): Boolean;
    function FindAttr(const Name: String): String;
    procedure AddElement(e: TXmlElement);
    function GetElement(const Name: String): TXmlElement;
    function FindElement(const Name: String): TXmlElement;
    procedure CheckName(const ExpectedName: String);

    property AttrCount: Integer read GetAttrCount;
    property ElementCount: Integer read GetElementCount;
    property Elements[Index: Integer]: TXmlElement read GetElements;
    property Name: String read FName write FName;
  end;

  TResourceResolver = class
  public
    procedure OpenFile(const FileName: String); virtual; abstract;
    function GetFileStream: TStream; virtual; abstract;
    procedure CloseFile; virtual; abstract;
  end;

  TTestParser = class
  private
    FResolver: TResourceResolver;
  public
    procedure DoTestDocument(e: TXmlElement; Doc: TTestDocument); virtual;
    procedure DoSection(e: TXmlElement; Section: TSection); virtual;
    procedure DoSections(e: TXmlElement; Section: TSection); virtual;
    procedure DoQuestions(e: TXmlElement; Section: TSection); virtual;
    procedure DoQuestion(e: TXmlElement; Section: TSection); virtual;
    procedure DoContent(e: TXmlElement; Pad: TPad); virtual;
    procedure DoTextPadObject(e: TXmlElement; Obj: TTextPadObject); virtual;
    procedure DoLineFeedPadObject(e: TXmlElement; Obj: TLineFeedPadObject); virtual;
    procedure DoGraphicPadObject(e: TXmlElement; Obj: TGraphicPadObject); virtual;

    procedure DoModifiers(e: TXmlElement; List: TModifierList); virtual;
    procedure DoModifier(e: TXmlElement; List: TModifierList); virtual;
    procedure DoSetNegativeChoiceContentModifier(e: TXmlElement; Modifier: TSetNegativeChoiceContentModifier); virtual;
    procedure DoSetEvaluationModelModifier(e: TXmlElement; Modifier: TSetEvaluationModelModifier); virtual;
    procedure DoSetWeightModifier(e: TXmlElement; Modifier: TSetWeightModifier); virtual;
    procedure DoScriptModifier(e: TXmlElement; Modifier: TScriptModifier); virtual;

    procedure DoSelectQuestion(e: TXmlElement; Question: TSelectQuestion); virtual;
    procedure DoSelectQuestionChoice(e: TXmlElement; Question: TSelectQuestion); virtual;
    procedure DoInputQuestion(e: TXmlElement; Question: TInputQuestion); virtual;
    procedure DoPattern(e: TXmlElement; Question: TInputQuestion); virtual;
    procedure DoTextPattern(e: TXmlElement; Pattern: TTextPattern); virtual;
    procedure DoRegexpPattern(e: TXmlElement; Pattern: TRegexpPattern); virtual;
    procedure DoMatchQuestion(e: TXmlElement; Question: TMatchQuestion); virtual;
    procedure DoMatchQuestionPair(e: TXmlElement; Question: TMatchQuestion); virtual;
    procedure DoMatchQuestionDistractor(e: TXmlElement; Question: TMatchQuestion); virtual;
    procedure DoMatchQuestionOptions(e: TXmlElement; Question: TMatchQuestion); virtual;
    procedure DoOrderQuestion(e: TXmlElement; Question: TOrderQuestion); virtual;
    procedure DoOrderQuestionItem(e: TXmlElement; Question: TOrderQuestion); virtual;
    procedure DoOrderQuestionDistractor(e: TXmlElement; Question: TOrderQuestion); virtual;
    procedure DoOrderQuestionOptions(e: TXmlElement; Question: TOrderQuestion); virtual;
    procedure DoClassifyQuestion(e: TXmlElement; Question: TClassifyQuestion); virtual;
    procedure DoClassifyQuestionCategory(e: TXmlElement; Question: TClassifyQuestion); virtual;
    procedure DoClassifyQuestionCategoryItem(e: TXmlElement; Category: TClassifyCategory); virtual;
    procedure DoClassifyQuestionOptions(e: TXmlElement; Question: TClassifyQuestion); virtual;

    procedure DoProfiles(e: TXmlElement; Profiles: TProfileList); virtual;
    procedure DoProfile(e: TXmlElement; Profile: TProfile); virtual;
    procedure DoConfiguration(e: TXmlElement; cf: TWorkConfiguration); virtual;
    procedure DoResultPolicy(e: TXmlElement; rp: TResultPolicy); virtual;
    procedure DoMarkScale(e: TXmlElement; ms: TMarkScale); virtual;

    property Resolver: TResourceResolver read FResolver write FResolver;
  end;

implementation

procedure SelectQuestionHandler(e: TXmlElement; Question: TQuestion; Parser: TTestParser);
begin
  Parser.DoSelectQuestion(e, Question as TSelectQuestion);
end;

procedure InputQuestionHandler(e: TXmlElement; Question: TQuestion; Parser: TTestParser);
begin
  Parser.DoInputQuestion(e, Question as TInputQuestion);
end;

procedure MatchQuestionHandler(e: TXmlElement; Question: TQuestion; Parser: TTestParser);
begin
  Parser.DoMatchQuestion(e, Question as TMatchQuestion);
end;

procedure OrderQuestionHandler(e: TXmlElement; Question: TQuestion; Parser: TTestParser);
begin
  Parser.DoOrderQuestion(e, Question as TOrderQuestion);
end;

procedure ClassifyQuestionHandler(e: TXmlElement; Question: TQuestion; Parser: TTestParser);
begin
  Parser.DoClassifyQuestion(e, Question as TClassifyQuestion);
end;

type
  TQuestionHandler = procedure(e: TXmlElement; Question: TQuestion; Parser: TTestParser);

  TXmlQuestionSpecifier = record
    QuestionClass: TQuestionClass;
    XmlType: String;
    Handler: TQuestionHandler;
  end;

const
  XmlQuestionSpecifiers: array [0..4] of TXmlQuestionSpecifier = (
    (QuestionClass: TSelectQuestion;   XmlType: VAL_QUESTION_TYPE_SELECT;   Handler: SelectQuestionHandler),
    (QuestionClass: TInputQuestion;    XmlType: VAL_QUESTION_TYPE_INPUT;    Handler: InputQuestionHandler),
    (QuestionClass: TMatchQuestion;    XmlType: VAL_QUESTION_TYPE_MATCH;    Handler: MatchQuestionHandler),
    (QuestionClass: TOrderQuestion;    XmlType: VAL_QUESTION_TYPE_ORDER;    Handler: OrderQuestionHandler),
    (QuestionClass: TClassifyQuestion; XmlType: VAL_QUESTION_TYPE_CLASSIFY; Handler: ClassifyQuestionHandler)
  );

procedure TextPadObjectHandler(e: TXmlElement; Obj: TPadObject; Parser: TTestParser);
begin
  Parser.DoTextPadObject(e, Obj as TTextPadObject);
end;

procedure LineFeedPadObjectHandler(e: TXmlElement; Obj: TPadObject; Parser: TTestParser);
begin
  Parser.DoLineFeedPadObject(e, Obj as TLineFeedPadObject);
end;

procedure GraphicPadObjectHandler(e: TXmlElement; Obj: TPadObject; Parser: TTestParser);
begin
  Parser.DoGraphicPadObject(e, Obj as TGraphicPadObject);
end;

type
  TPadObjectHandler = procedure(e: TXmlElement; Obj: TPadObject; Parser: TTestParser);

  TXmlPadObjectSpecifier = record
    PadObjectClass: TPadObjectClass;
    ElementName: String;
    Handler: TPadObjectHandler;
  end;

const
  XmlPadObjectSpecifiers: array [0..2] of TXmlPadObjectSpecifier = (
    (PadObjectClass: TTextPadObject;     ElementName: ELEM_TEXT; Handler: TextPadObjectHandler),
    (PadObjectClass: TLineFeedPadObject; ElementName: ELEM_BR;   Handler: LineFeedPadObjectHandler),
    (PadObjectClass: TGraphicPadObject;  ElementName: ELEM_IMG;  Handler: GraphicPadObjectHandler)
  );

type
  TXmlImageSpecifier = record
    Format: String;
    Extension: String;
  end;

const
  XmlImageSpecifiers: array [0..1] of TXmlImageSpecifier = (
    (Format: 'PNG';  Extension: IT_IMAGE_PNG_EXTENSION),
    (Format: 'JPEG'; Extension: IT_IMAGE_JPG_EXTENSION)
  );

procedure TextPatternHandler(e: TXmlElement; Pattern: TPattern; Parser: TTestParser);
begin
  Parser.DoTextPattern(e, Pattern as TTextPattern);
end;

procedure RegexpPatternHandler(e: TXmlElement; Pattern: TPattern; Parser: TTestParser);
begin
  Parser.DoRegexpPattern(e, Pattern as TRegexpPattern);
end;

type
  TPatternHandler = procedure(e: TXmlElement; Pattern: TPattern; Parser: TTestParser);

  TXmlPatternSpecifier = record
    PatternClass: TPatternClass;
    XmlType: String;
    Handler: TPatternHandler;
  end;

const
  XmlPatternSpecifiers: array [0..1] of TXmlPatternSpecifier = (
    (PatternClass: TTextPattern;   XmlType: VAL_PATTERN_TYPE_TEXT;   Handler: TextPatternHandler),
    (PatternClass: TRegexpPattern; XmlType: VAL_PATTERN_TYPE_REGEXP; Handler: RegexpPatternHandler)
  );

procedure NullModifierHandler(e: TXmlElement; Modifier: TModifier; Parser: TTestParser);
begin
  { do nothing }
end;

procedure SetNegativeChoiceContentModifierHandler(e: TXmlElement; Modifier: TModifier; Parser: TTestParser);
begin
  Parser.DoSetNegativeChoiceContentModifier(e, Modifier as TSetNegativeChoiceContentModifier);
end;

procedure SetEvaluationModelModifierHandler(e: TXmlElement; Modifier: TModifier; Parser: TTestParser);
begin
  Parser.DoSetEvaluationModelModifier(e, Modifier as TSetEvaluationModelModifier);
end;

procedure SetWeightModifierHandler(e: TXmlElement; Modifier: TModifier; Parser: TTestParser);
begin
  Parser.DoSetWeightModifier(e, Modifier as TSetWeightModifier);
end;

procedure ScriptModifierHandler(e: TXmlElement; Modifier: TModifier; Parser: TTestParser);
begin
  Parser.DoScriptModifier(e, Modifier as TScriptModifier);
end;

type
  TModifierHandler = procedure(e: TXmlElement; Modifier: TModifier; Parser: TTestParser);

  TXmlModifierSpecifier = record
    ModifierClass: TModifierClass;
    XmlType: String;
    Handler: TModifierHandler;
  end;

const
  XmlModifierSpecifiers: array [0..6] of TXmlModifierSpecifier = (
    (ModifierClass: TSuppressSingleChoiceHintModifier; XmlType: VAL_MODIFIER_TYPE_SUPPRESS_SINGLE_CHOICE_HINT; Handler: NullModifierHandler),
    (ModifierClass: TAddNegativeChoiceModifier;        XmlType: VAL_MODIFIER_TYPE_ADD_NEGATIVE_CHOICE;         Handler: NullModifierHandler),
    (ModifierClass: TSetNegativeChoiceContentModifier; XmlType: VAL_MODIFIER_TYPE_SET_NEGATIVE_CHOICE_CONTENT; Handler: SetNegativeChoiceContentModifierHandler),
    (ModifierClass: TShuffleChoicesModifier;           XmlType: VAL_MODIFIER_TYPE_SHUFFLE_CHOICES;             Handler: NullModifierHandler),
    (ModifierClass: TSetEvaluationModelModifier;       XmlType: VAL_MODIFIER_TYPE_SET_EVALUATION_MODEL;        Handler: SetEvaluationModelModifierHandler),
    (ModifierClass: TSetWeightModifier;                XmlType: VAL_MODIFIER_TYPE_SET_WEIGHT;                  Handler: SetWeightModifierHandler),
    (ModifierClass: TScriptModifier;                   XmlType: VAL_MODIFIER_TYPE_SCRIPT;                      Handler: ScriptModifierHandler)
  );

function FindQuestionSpecifier(const XmlType: String): TXmlQuestionSpecifier;
var
  i: Integer;
begin
  for i := Low(XmlQuestionSpecifiers) to High(XmlQuestionSpecifiers) do
    if SameText(XmlQuestionSpecifiers[i].XmlType, XmlType) then
    begin
      Result := XmlQuestionSpecifiers[i];
      Exit;
    end;
  raise Exception.CreateFmt('Unknown question type: "%s".', [XmlType]);
end;

function XmlValueToBoolean(const v: String): Boolean;
begin
  if SameText(v, VAL_TRUE) then
    Result := TRUE
  else if SameText(v, VAL_FALSE) then
    Result := FALSE
  else
    raise Exception.CreateFmt('"%s" is not a valid boolean value.', [v]);  
end;

function FindPadObjectSpecifier(const ElementName: String): TXmlPadObjectSpecifier;
var
  i: Integer;
begin
  for i := Low(XmlPadObjectSpecifiers) to High(XmlPadObjectSpecifiers) do
    if SameText(XmlPadObjectSpecifiers[i].ElementName, ElementName) then
    begin
      Result := XmlPadObjectSpecifiers[i];
      Exit;
    end;
  raise Exception.CreateFmt('Unknown content type: "%s".', [ElementName]);
end;

function FindImageSpecifier(const Extension: String): TXmlImageSpecifier;
var
  i: Integer;
begin
  for i := Low(XmlImageSpecifiers) to High(XmlImageSpecifiers) do
    if SameText(XmlImageSpecifiers[i].Extension, Extension) then
    begin
      Result := XmlImageSpecifiers[i];
      Exit;
    end;
  raise Exception.CreateFmt('Unknown image format: "%s".', [Extension]);
end;

function FindPatternSpecifier(const XmlType: String): TXmlPatternSpecifier;
var
  i: Integer;
begin
  for i := Low(XmlPatternSpecifiers) to High(XmlPatternSpecifiers) do
    if SameText(XmlPatternSpecifiers[i].XmlType, XmlType) then
    begin
      Result := XmlPatternSpecifiers[i];
      Exit;
    end;
  raise Exception.CreateFmt('Unknown pattern type: "%s".', [XmlType]);
end;

function XmlValueToSingle(const v: String): Single;
begin
  Result := StrToFloat(v);
end;

procedure RaiseBadAttr(const AttrName, AttrValue: String);
begin
  raise Exception.CreateFmt('"%s" is not a valid value for the attribute "%s".', [AttrValue, AttrName]);
end;

function StrToIntZeroSpecial(const s, ZeroString, AttrName: String): Integer;
begin
  if SameText(s, ZeroString) then
    Result := 0
  else
  begin
    Result := StrToInt(s);
    if Result = 0 then
      RaiseBadAttr(AttrName, s);
  end;
end;

function FindModifierSpecifier(const XmlType: String): TXmlModifierSpecifier;
var
  i: Integer;
begin
  for i := Low(XmlModifierSpecifiers) to High(XmlModifierSpecifiers) do
    if SameText(XmlModifierSpecifiers[i].XmlType, XmlType) then
    begin
      Result := XmlModifierSpecifiers[i];
      Exit;
    end;
  raise Exception.CreateFmt('Unknown modifier type: "%s".', [XmlType]);
end;

function XmlToLaxEvaluation(const s: String): Boolean;
begin
  if SameText(s, VAL_EVALUATION_MODEL_TYPE_LAX) then
    Result := TRUE
  else if SameText(s, VAL_EVALUATION_MODEL_TYPE_DICHOTOMIC) then
    Result := FALSE
  else
    raise Exception.CreateFmt('Unknown evaluation model type: "%s".', [s]);
end;

procedure RaiseBadElement(const ElementName: String);
begin
  raise Exception.CreateFmt('Element "%s" is not allowed in the given context.', [ElementName]);
end;

procedure RaiseBadAttributeValue(const ElementName, AttributeName: String);
begin
  raise Exception.CreateFmt('Attribute "%s" of element "%s" has invalid value in the given context.',
    [AttributeName, ElementName]);
end;

{ TTestParser }

procedure TTestParser.DoClassifyQuestion(e: TXmlElement;
  Question: TClassifyQuestion);
var
  c: TXmlElement;
  i: Integer;
begin
  DoClassifyQuestionOptions(e.FindElement(ELEM_CLASSIFY_OPTIONS), Question);

  c := e.GetElement(ELEM_CATEGORIES);
  if c <> nil then
    for i := 0 to c.ElementCount-1 do
      DoClassifyQuestionCategory(c.Elements[i], Question);
end;

procedure TTestParser.DoClassifyQuestionCategory(e: TXmlElement;
  Question: TClassifyQuestion);
var
  Category: TClassifyCategory;
  c: TXmlElement;
  i: Integer;
begin
  e.CheckName(ELEM_CATEGORY);
  Category := TClassifyCategory.Create;
  Question.AddCategory(Category);
  DoContent(e.FindElement(ELEM_CATEGORY_TITLE).FindElement(ELEM_CONTENT), Category.Title);

  c := e.GetElement(ELEM_CATEGORY_ITEMS);
  if c <> nil then
    for i := 0 to c.ElementCount-1 do
      DoClassifyQuestionCategoryItem(c.Elements[i], Category);
end;

procedure TTestParser.DoClassifyQuestionCategoryItem(e: TXmlElement;
  Category: TClassifyCategory);
var
  Item: TPad;
begin
  e.CheckName(ELEM_CATEGORY_ITEM);
  Item := TPad.Create;
  Category.Items.Add(Item);
  DoContent(e.FindElement(ELEM_CONTENT), Item);
end;

procedure TTestParser.DoClassifyQuestionOptions(e: TXmlElement;
  Question: TClassifyQuestion);
var
  v: String;
  n: Integer;
begin
  e.CheckName(ELEM_CLASSIFY_OPTIONS);
  Question.ItemLimit := StrToIntZeroSpecial(e.FindAttr(ATTR_ITEMS_USED), VAL_ALL,
    ATTR_ITEMS_USED);

  v := e.FindAttr(ATTR_MIN_ITEMS_PER_CATEGORY_USED);
  if Question.ItemLimit = 0 then
  begin
    if not SameText(v, VAL_ALL) then
      RaiseBadAttr(ATTR_MIN_ITEMS_PER_CATEGORY_USED, v);
    n := 0;
  end
  else
    n := StrToInt(v);
  Question.MinItemsPerCategory := n;
end;

procedure TTestParser.DoTextPattern(e: TXmlElement;
  Pattern: TTextPattern);
var
  s: String;
begin
  Pattern.Value := UTF8Decode(e.FindAttr(ATTR_VALUE));
  Pattern.Quality := XmlValueToSingle(e.FindAttr(ATTR_QUALITY));
  Pattern.CaseSensitive := XmlValueToBoolean(e.FindAttr(ATTR_CASE_SENSITIVE));

  s := e.FindAttr(ATTR_SPACES);
  if SameText(s, VAL_PATTERN_SPACES_NORMALIZE) then
    Pattern.SpaceDelimited := TRUE
  else if SameText(s, VAL_PATTERN_SPACES_IGNORE) then
    Pattern.SpaceDelimited := FALSE
  else
    RaiseBadAttr(ATTR_SPACES, s);

  Pattern.NumericAware := XmlValueToBoolean(e.FindAttr(ATTR_NUMERIC_AWARE));
  if Pattern.NumericAware then
    Pattern.Precision := TFixedPointDecimal.Normalize(e.FindAttr(ATTR_PRECISION))
  else
    Pattern.Precision := '0';

  Pattern.Wildcard := XmlValueToBoolean(e.FindAttr(ATTR_WILDCARD));
end;

procedure TTestParser.DoMatchQuestion(e: TXmlElement;
  Question: TMatchQuestion);
var
  c: TXmlElement;
  i: Integer;
begin
  DoMatchQuestionOptions(e.FindElement(ELEM_MATCH_OPTIONS), Question);

  c := e.GetElement(ELEM_PAIRS);
  if c <> nil then
    for i := 0 to c.ElementCount-1 do
      DoMatchQuestionPair(c.Elements[i], Question);

  c := e.GetElement(ELEM_DISTRACTORS);
  if c <> nil then
    for i := 0 to c.ElementCount-1 do
      DoMatchQuestionDistractor(c.Elements[i], Question);
end;

procedure TTestParser.DoMatchQuestionDistractor(e: TXmlElement;
  Question: TMatchQuestion);
var
  Item: TPad;
begin
  e.CheckName(ELEM_DISTRACTOR);

  Item := TPad.Create;
  Question.Right.Add(Item);
  DoContent(e.FindElement(ELEM_CONTENT), Item);
end;

procedure TTestParser.DoMatchQuestionOptions(e: TXmlElement;
  Question: TMatchQuestion);
var
  v: String;
  n: Integer;
begin
  e.CheckName(ELEM_MATCH_OPTIONS);
  Question.PairLimit := StrToIntZeroSpecial(e.FindAttr(ATTR_BASE_ITEMS_USED), VAL_ALL,
    ATTR_BASE_ITEMS_USED);

  v := e.FindAttr(ATTR_DISTRACTORS_USED);
  if v = '0' then
    n := -1
  else
  begin
    n := StrToIntZeroSpecial(v, VAL_ALL, ATTR_DISTRACTORS_USED);
    if n = -1 then
      RaiseBadAttr(ATTR_DISTRACTORS_USED, v);
  end;
  Question.DistractorLimit := n;
end;

procedure TTestParser.DoMatchQuestionPair(e: TXmlElement;
  Question: TMatchQuestion);
var
  Item: TPad;
begin
  e.CheckName(ELEM_PAIR);

  Item := TPad.Create;
  Question.Left.Add(Item);
  DoContent(e.FindElement(ELEM_BASE_ITEM).FindElement(ELEM_CONTENT), Item);

  Item := TPad.Create;
  Question.Right.Add(Item);
  DoContent(e.FindElement(ELEM_MATCHING_ITEM).FindElement(ELEM_CONTENT), Item);
end;

procedure TTestParser.DoConfiguration(e: TXmlElement;
  cf: TWorkConfiguration);
var
  c: TXmlElement;
  s: String;
begin
  e.CheckName(ELEM_PROFILE);

  c := e.FindElement(ELEM_QUESTION_SELECTION);
  cf.QuestionsPerSection := StrToIntZeroSpecial(c.FindAttr(ATTR_QUESTIONS_PER_SECTION),
    VAL_ALL, ATTR_QUESTIONS_PER_SECTION);
  cf.UseLabelFilter := c.GetAttr(ATTR_LABEL_FILTER, s);
  cf.LabelFilter := s;
  cf.ShuffleQuestions := XmlValueToBoolean(c.FindAttr(ATTR_SHUFFLE_QUESTIONS));

  c := e.FindElement(ELEM_SESSION_OPTIONS);
  cf.DurationMinutes := StrToIntZeroSpecial(c.FindAttr(ATTR_DURATION_MINUTES),
    VAL_UNLIMITED, ATTR_DURATION_MINUTES);
  cf.EditableAnswers := XmlValueToBoolean(c.FindAttr(ATTR_EDITABLE_ANSWERS));
  cf.BrowsableQuestions := XmlValueToBoolean(c.FindAttr(ATTR_BROWSABLE_QUESTIONS));
  cf.WeightCues := XmlValueToBoolean(c.FindAttr(ATTR_WEIGHT_CUES));

  if cf.EditableAnswers then
  begin
    if e.GetElement(ELEM_INSTANT_FEEDBACK) <> nil then
      RaiseBadElement(ELEM_INSTANT_FEEDBACK);
    cf.InstantAnswerCorrectness := FALSE;
    cf.InstantTotalPercentCorrect := FALSE;
  end
  else
  begin
    c := e.FindElement(ELEM_INSTANT_FEEDBACK);
    cf.InstantAnswerCorrectness := XmlValueToBoolean(c.FindAttr(ATTR_ANSWER_CORRECTNESS));
    cf.InstantTotalPercentCorrect := XmlValueToBoolean(c.FindAttr(ATTR_TOTAL_PERCENT_CORRECT));
  end;
end;

procedure TTestParser.DoContent(e: TXmlElement; Pad: TPad);
var
  i: Integer;
  c: TXmlElement;
  Spec: TXmlPadObjectSpecifier;
  Obj: TPadObject;
begin
  e.CheckName(ELEM_CONTENT);
  Pad.Clear;
  for i := 0 to e.ElementCount-1 do
  begin
    c := e.Elements[i];
    Spec := FindPadObjectSpecifier(c.Name);
    Obj := Spec.PadObjectClass.Create;
    Pad.AddObject(Obj);
    Spec.Handler(c, Obj, Self);
  end;
end;

procedure TTestParser.DoGraphicPadObject(e: TXmlElement; Obj: TGraphicPadObject);
var
  FileName, ClipboardFormat: String;
begin
  FileName := e.FindAttr(ATTR_SRC);
  Obj.ImageFormat := FindImageSpecifier(GetStringTailAfterLastDelimiter(FileName, '.')).Format;

  FResolver.OpenFile(FileName);
  Obj.ImageData := ReadUnseekableStreamTail(FResolver.GetFileStream);
  FResolver.CloseFile;

  if e.GetAttr(ATTR_CLIPBOARD_FORMAT, ClipboardFormat) then
  begin
    Obj.SourceFormat := ClipboardFormat;
    FileName := e.FindAttr(ATTR_CLIPBOARD_DATA);

    FResolver.OpenFile(FileName);
    Obj.SourceData := ReadUnseekableStreamTail(FResolver.GetFileStream);
    FResolver.CloseFile;
  end;
end;

procedure TTestParser.DoLineFeedPadObject(e: TXmlElement; Obj: TLineFeedPadObject);
begin
  { do nothing }
end;

procedure TTestParser.DoMarkScale(e: TXmlElement; ms: TMarkScale);
var
  c: TXmlElement;
  i: Integer;
  Items: TMarkScaleItemList;

  procedure DoMark(m: TXmlElement);
  var
    Item: TMarkScaleItem;
  begin
    m.CheckName(ELEM_MARK);
    Item := TMarkScaleItem.Create;
    Items.AddSafely(Item);
    Item.Mark := m.FindAttr(ATTR_TITLE);
    Item.LowerBound := XmlValueToSingle(m.FindAttr(ATTR_LOWER_BOUND));
  end;

begin
  e.CheckName(ELEM_MARK_SCALE);
  c := e.FindElement(ELEM_MARKS);
  Items := TMarkScaleItemList.Create;
  try
    for i := 0 to c.ElementCount-1 do
      DoMark(c.Elements[i]);
    ms.SetItems(Items);
  finally
    Items.Free;
  end;
end;

procedure TTestParser.DoModifier(e: TXmlElement; List: TModifierList);
var
  Spec: TXmlModifierSpecifier;
  Modifier: TModifier;
begin
  e.CheckName(ELEM_MODIFIER);
  Spec := FindModifierSpecifier(e.FindAttr(ATTR_TYPE));
  Modifier := Spec.ModifierClass.Create;
  List.Add(Modifier);
  Spec.Handler(e, Modifier, Self);
end;

procedure TTestParser.DoModifiers(e: TXmlElement; List: TModifierList);
var
  i: Integer;
begin
  e.CheckName(ELEM_MODIFIERS);
  for i := 0 to e.ElementCount-1 do
    DoModifier(e.Elements[i], List);
end;

procedure TTestParser.DoPattern(e: TXmlElement;
  Question: TInputQuestion);
var
  Spec: TXmlPatternSpecifier;
  Pattern: TPattern;
begin
  e.CheckName(ELEM_PATTERN);
  Spec := FindPatternSpecifier(e.FindAttr(ATTR_TYPE));
  Pattern := Spec.PatternClass.Create;
  Question.Add(Pattern);
  Spec.Handler(e, Pattern, Self);
end;

procedure TTestParser.DoProfile(e: TXmlElement; Profile: TProfile);
var
  c: TXmlElement;
begin
  e.CheckName(ELEM_PROFILE);
  Profile.Title := e.FindAttr(ATTR_TITLE);
  DoConfiguration(e, Profile.Configuration);

  c := e.GetElement(ELEM_TEST_RESULTS);
  if c <> nil then
    DoResultPolicy(c, Profile.ResultPolicy);

  c := e.GetElement(ELEM_MARK_SCALE);
  if c <> nil then
    DoMarkScale(c, Profile.MarkScale);

  c := e.GetElement(ELEM_MODIFIERS);
  if c <> nil then
    DoModifiers(c, Profile.ModifierList);
end;

procedure TTestParser.DoProfiles(e: TXmlElement; Profiles: TProfileList);
var
  i: Integer;
  Profile: TProfile;
begin
  e.CheckName(ELEM_PROFILES);
  for i := 0 to e.ElementCount-1 do
  begin
    Profile := TProfile.Create;
    Profiles.Add(Profile);
    DoProfile(e.Elements[i], Profile);
  end;
end;

procedure TTestParser.DoQuestion(e: TXmlElement; Section: TSection);
var
  Spec: TXmlQuestionSpecifier;
  Question: TQuestion;
  c: TXmlElement;
begin
  e.CheckName(ELEM_QUESTION);
  Spec := FindQuestionSpecifier(e.FindAttr(ATTR_TYPE));
  Question := Spec.QuestionClass.Create;
  Section.AddQuestion(Question);

  Question.Weight := StrToInt(e.FindAttr(ATTR_WEIGHT));

  if Question is TQuestionWithFormulation then
    DoContent(e.FindElement(ELEM_CONTENT), TQuestionWithFormulation(Question).Formulation);

  Spec.Handler(e, Question, Self);

  c := e.GetElement(ELEM_MODIFIERS);
  if c <> nil then
    DoModifiers(c, Question.Modifiers);
end;

procedure TTestParser.DoQuestions(e: TXmlElement; Section: TSection);
var
  i: Integer;
begin
  e.CheckName(ELEM_QUESTIONS);
  for i := 0 to e.ElementCount-1 do
    DoQuestion(e.Elements[i], Section);
end;

procedure TTestParser.DoRegexpPattern(e: TXmlElement;
  Pattern: TRegexpPattern);
var
  s: String;
begin
  Pattern.Value := UTF8Decode(e.FindAttr(ATTR_VALUE));
  Pattern.Quality := XmlValueToSingle(e.FindAttr(ATTR_QUALITY));
  Pattern.CaseSensitive := XmlValueToBoolean(e.FindAttr(ATTR_CASE_SENSITIVE));

  s := e.FindAttr(ATTR_SPACES);
  if SameText(s, VAL_PATTERN_SPACES_EXACT) then
  begin
    Pattern.PreprocessSpaces := FALSE;
    Pattern.NormalizeSpaces := TRUE;
  end
  else
  begin
    Pattern.PreprocessSpaces := TRUE;
    if SameText(s, VAL_PATTERN_SPACES_NORMALIZE) then
      Pattern.NormalizeSpaces := TRUE
    else if SameText(s, VAL_PATTERN_SPACES_IGNORE) then
      Pattern.NormalizeSpaces := FALSE
    else
      RaiseBadAttr(ATTR_SPACES, s);
  end;
end;

procedure TTestParser.DoResultPolicy(e: TXmlElement;
  rp: TResultPolicy);
var
  c: TXmlElement;
begin
  e.CheckName(ELEM_TEST_RESULTS);
  rp.ResultsAvailable := TRUE;
  rp.PercentCorrect := XmlValueToBoolean(e.FindAttr(ATTR_PERCENT_CORRECT));
  rp.Points := XmlValueToBoolean(e.FindAttr(ATTR_POINTS));
  rp.Mark := XmlValueToBoolean(e.FindAttr(ATTR_MARK));

  c := e.GetElement(ELEM_QUESTION_RESULTS);
  if c <> nil then
  begin
    rp.QuestionResultsAvailable := TRUE;
    rp.QuestionPercentCorrect := XmlValueToBoolean(c.FindAttr(ATTR_PERCENT_CORRECT));
    rp.QuestionPoints := XmlValueToBoolean(c.FindAttr(ATTR_POINTS));
    rp.QuestionCorrectAnswer := XmlValueToBoolean(c.FindAttr(ATTR_CORRECT_ANSWER));
  end;

  c := e.GetElement(ELEM_SECTION_RESULTS);
  if c <> nil then
  begin
    rp.SectionResultsAvailable := TRUE;
    rp.SectionPercentCorrect := XmlValueToBoolean(c.FindAttr(ATTR_PERCENT_CORRECT));
    rp.SectionPoints := XmlValueToBoolean(c.FindAttr(ATTR_POINTS));
    rp.SectionQuestionCount := XmlValueToBoolean(c.FindAttr(ATTR_QUESTION_COUNT));
    rp.SectionQuestionList := XmlValueToBoolean(c.FindAttr(ATTR_QUESTION_LIST));
    if rp.SectionQuestionList and not rp.QuestionResultsAvailable then
      RaiseBadAttributeValue(ELEM_SECTION_RESULTS, ATTR_QUESTION_LIST);
  end;
end;

procedure TTestParser.DoScriptModifier(e: TXmlElement;
  Modifier: TScriptModifier);
var
  Script: TStringList;
  i: Integer;

  procedure DoScriptLine(c: TXmlElement);
  begin
    c.CheckName(ELEM_SCRIPT);
    Script.Add(c.FindAttr(ATTR_LINE));
  end;

begin
  Script := TStringList.Create;
  try
    for i := 0 to e.ElementCount-1 do
      DoScriptLine(e.Elements[i]);
    Modifier.SetScript(Script);
  finally
    Script.Free;
  end;
end;

procedure TTestParser.DoSection(e: TXmlElement; Section: TSection);
var
  c: TXmlElement;
begin
  e.CheckName(ELEM_SECTION);
  Section.Name := e.FindAttr(ATTR_TITLE);

  c := e.GetElement(ELEM_QUESTIONS);
  if c <> nil then
    DoQuestions(c, Section);

  c := e.GetElement(ELEM_SECTIONS);
  if c <> nil then
    DoSections(c, Section);

  c := e.GetElement(ELEM_MODIFIERS);
  if c <> nil then
    DoModifiers(c, Section.Modifiers);
end;

procedure TTestParser.DoSections(e: TXmlElement; Section: TSection);
var
  i: Integer;
  ChildSection: TSection;
begin
  e.CheckName(ELEM_SECTIONS);
  for i := 0 to e.ElementCount-1 do
  begin
    ChildSection := TSection.Create;
    Section.AddSection(ChildSection);
    DoSection(e.Elements[i], ChildSection);
  end;
end;

procedure TTestParser.DoOrderQuestion(e: TXmlElement;
  Question: TOrderQuestion);
var
  c: TXmlElement;
  i: Integer;
begin
  DoOrderQuestionOptions(e.FindElement(ELEM_ORDER_OPTIONS), Question);

  c := e.GetElement(ELEM_SEQUENCE);
  if c <> nil then
    for i := 0 to c.ElementCount-1 do
      DoOrderQuestionItem(c.Elements[i], Question);

  c := e.GetElement(ELEM_DISTRACTORS);
  if c <> nil then
    for i := 0 to c.ElementCount-1 do
      DoOrderQuestionDistractor(c.Elements[i], Question);
end;

procedure TTestParser.DoOrderQuestionItem(e: TXmlElement;
  Question: TOrderQuestion);
var
  Item: TPad;
begin
  e.CheckName(ELEM_SEQUENCE_ITEM);

  Item := TPad.Create;
  Question.Items.Add(Item);
  DoContent(e.FindElement(ELEM_CONTENT), Item);
end;

procedure TTestParser.DoOrderQuestionOptions(e: TXmlElement;
  Question: TOrderQuestion);
begin
  e.CheckName(ELEM_ORDER_OPTIONS);
  Question.ItemLimit := StrToIntZeroSpecial(e.FindAttr(ATTR_SEQUENCE_ITEMS_USED),
    VAL_ALL, ATTR_SEQUENCE_ITEMS_USED);
  Question.DistractorLimit := StrToIntZeroSpecial(e.FindAttr(ATTR_DISTRACTORS_USED),
    VAL_ALL, ATTR_DISTRACTORS_USED);
end;

procedure TTestParser.DoOrderQuestionDistractor(e: TXmlElement;
  Question: TOrderQuestion);
var
  Item: TPad;
begin
  e.CheckName(ELEM_DISTRACTOR);

  Item := TPad.Create;
  Question.Distractors.Add(Item);
  DoContent(e.FindElement(ELEM_CONTENT), Item);
end;

procedure TTestParser.DoSetEvaluationModelModifier(e: TXmlElement;
  Modifier: TSetEvaluationModelModifier);
var
  c: TXmlElement;
  i: Integer;

  procedure DoApplyTo(a: TXmlElement);
  var
    QuestionSpec: TXmlQuestionSpecifier;
  begin
    a.CheckName(ELEM_QUESTION_TYPE);
    QuestionSpec := FindQuestionSpecifier(a.FindAttr(ATTR_VALUE));
    Modifier.QuestionClasses.Add(QuestionSpec.QuestionClass);
  end;

begin
  Modifier.LaxEvaluation := XmlToLaxEvaluation(e.FindAttr(ATTR_NEW_EVALUATION_MODEL));

  c := e.GetElement(ELEM_APPLY_TO);
  if c <> nil then
    for i := 0 to c.ElementCount-1 do
      DoApplyTo(c.Elements[i]);
end;

procedure TTestParser.DoSetNegativeChoiceContentModifier(e: TXmlElement;
  Modifier: TSetNegativeChoiceContentModifier);
var
  Content: TPad;
begin
  Content := TPad.Create;
  try
    DoContent(e.FindElement(ELEM_CONTENT), Content);
    Modifier.SetContent(Content);
  finally
    Content.Free;
  end;
end;

procedure TTestParser.DoSetWeightModifier(e: TXmlElement;
  Modifier: TSetWeightModifier);
begin
  Modifier.NewWeight := StrToInt(e.FindAttr(ATTR_NEW_WEIGHT));
end;

procedure TTestParser.DoInputQuestion(e: TXmlElement;
  Question: TInputQuestion);
var
  c: TXmlElement;
  i: Integer;
begin
  c := e.GetElement(ELEM_PATTERNS);
  if c <> nil then
    for i := 0 to c.ElementCount-1 do
      DoPattern(c.Elements[i], Question);
end;

procedure TTestParser.DoSelectQuestionChoice(e: TXmlElement;
  Question: TSelectQuestion);
var
  Choice: TChoice;
begin
  e.CheckName(ELEM_CHOICE);
  Choice := Question.AddChoice;
  if XmlValueToBoolean(e.FindAttr(ATTR_CORRECT)) then
    Question.Response.Select(Question.ChoiceCount-1);
  if XmlValueToBoolean(e.FindAttr(ATTR_FIXED)) then
    Choice.Flags := Choice.Flags + [cfFixed];
  if XmlValueToBoolean(e.FindAttr(ATTR_NEGATIVE)) then
    Choice.Flags := Choice.Flags + [cfNegative];

  DoContent(e.FindElement(ELEM_CONTENT), Choice.Pad);
end;

procedure TTestParser.DoTestDocument(e: TXmlElement; Doc: TTestDocument);
var
  c: TXmlElement;
begin
  e.CheckName(ELEM_IREN_TEST);

  DoSection(e.FindElement(ELEM_SECTION), Doc.Test.Section);
  c := e.GetElement(ELEM_PROFILES);
  if c <> nil then
    DoProfiles(c, Doc.Profiles);
end;

procedure TTestParser.DoSelectQuestion(e: TXmlElement;
  Question: TSelectQuestion);
var
  c: TXmlElement;
  i: Integer;
begin
  c := e.GetElement(ELEM_CHOICES);
  if c <> nil then
    for i := 0 to c.ElementCount-1 do
      DoSelectQuestionChoice(c.Elements[i], Question);
end;

procedure TTestParser.DoTextPadObject(e: TXmlElement; Obj: TTextPadObject);
begin
  Obj.Text := UTF8Decode(e.FindAttr(ATTR_VALUE));
end;

{ TXmlElement.TXmlAttribute }

constructor TXmlElement.TXmlAttribute.Create(const Name, Value: String);
begin
  inherited Create;
  FName := Name;
  FValue := Value;
end;

{ TXmlElement }

procedure TXmlElement.AddAttr(const Name, Value: String);
begin
  FAttrs.AddSafely(TXmlAttribute.Create(Name, Value));
end;

procedure TXmlElement.AddElement(e: TXmlElement);
begin
  FElements.Add(e);
end;

procedure TXmlElement.CheckName(const ExpectedName: String);
begin
  if not SameText(FName, ExpectedName) then
    raise Exception.CreateFmt('Element "%s" found instead of expected "%s".',
      [FName, ExpectedName]);
end;

constructor TXmlElement.Create(const Name: String);
begin
  inherited Create;
  FName := Name;
  FAttrs := TXmlAttributeList.Create;
  FElements := TXmlElementList.Create(FALSE);
end;

destructor TXmlElement.Destroy;
begin
  FreeAndNil(FAttrs);
  FreeAndNil(FElements);
  inherited;
end;

function TXmlElement.FindAttr(const Name: String): String;
begin
  if not GetAttr(Name, Result) then
    raise Exception.CreateFmt('Attribute "%s" of element "%s" is missing.', [Name, FName]);
end;

function TXmlElement.FindElement(const Name: String): TXmlElement;
begin
  Result := GetElement(Name);
  if Result = nil then
    raise Exception.CreateFmt('Element "%s" not found in parent element "%s".',
      [Name, FName]);
end;

function TXmlElement.GetAttr(const Name: String; out Value: String): Boolean;
var
  a: TXmlAttribute;
  UpperName: String;
begin
  Result := FALSE;
  Value := '';
  UpperName := UpperCase(Name);
  for a in FAttrs do
    if UpperCase(a.FName) = UpperName then
    begin
      Result := TRUE;
      Value := a.FValue;
      Break;
    end;
end;

function TXmlElement.GetAttrCount: Integer;
begin
  Result := FAttrs.Count;
end;

function TXmlElement.GetElement(const Name: String): TXmlElement;
var
  UpperName: String;
begin
  UpperName := UpperCase(Name);
  for Result in FElements do
    if UpperCase(Result.FName) = UpperName then
      Exit;
  Result := nil;
end;

function TXmlElement.GetElementCount: Integer;
begin
  Result := FElements.Count;
end;

function TXmlElement.GetElements(Index: Integer): TXmlElement;
begin
  Assert( Index >= 0 );
  Assert( Index < ElementCount );
  Result := FElements[Index];
end;

end.
